home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / perl / perl5a1.lha / perl5alpha1 / doop.c < prev    next >
C/C++ Source or Header  |  1993-07-31  |  12KB  |  555 lines
  1. /* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    doarg.c,v $
  9.  * Revision 4.1  92/08/07  17:19:37  lwall
  10.  * Stage 6 Snapshot
  11.  * 
  12.  * Revision 4.0.1.7  92/06/11  21:07:11  lwall
  13.  * patch34: join with null list attempted negative allocation
  14.  * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd  "
  15.  * 
  16.  * Revision 4.0.1.6  92/06/08  12:34:30  lwall
  17.  * patch20: removed implicit int declarations on funcions
  18.  * patch20: pattern modifiers i and o didn't interact right
  19.  * patch20: join() now pre-extends target string to avoid excessive copying
  20.  * patch20: fixed confusion between a *var's real name and its effective name
  21.  * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
  22.  * patch20: usersub routines didn't reclaim temp values soon enough
  23.  * patch20: ($<,$>) = ... didn't work on some architectures
  24.  * patch20: added Atari ST portability
  25.  * 
  26.  * Revision 4.0.1.5  91/11/11  16:31:58  lwall
  27.  * patch19: added little-endian pack/unpack options
  28.  * 
  29.  * Revision 4.0.1.4  91/11/05  16:35:06  lwall
  30.  * patch11: /$foo/o optimizer could access deallocated data
  31.  * patch11: minimum match length calculation in regexp is now cumulative
  32.  * patch11: added some support for 64-bit integers
  33.  * patch11: prepared for ctype implementations that don't define isascii()
  34.  * patch11: sprintf() now supports any length of s field
  35.  * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
  36.  * patch11: defined(&$foo) and undef(&$foo) didn't work
  37.  * 
  38.  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  39.  * patch10: pack(hh,1) dumped core
  40.  * 
  41.  * Revision 4.0.1.2  91/06/07  10:42:17  lwall
  42.  * patch4: new copyright notice
  43.  * patch4: // wouldn't use previous pattern if it started with a null character
  44.  * patch4: //o and s///o now optimize themselves fully at runtime
  45.  * patch4: added global modifier for pattern matches
  46.  * patch4: undef @array disabled "@array" interpolation
  47.  * patch4: chop("") was returning "\0" rather than ""
  48.  * patch4: vector logical operations &, | and ^ sometimes returned null string
  49.  * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
  50.  * 
  51.  * Revision 4.0.1.1  91/04/11  17:40:14  lwall
  52.  * patch1: fixed undefined environ problem
  53.  * patch1: fixed debugger coredump on subroutines
  54.  * 
  55.  * Revision 4.0  91/03/20  01:06:42  lwall
  56.  * 4.0 baseline.
  57.  * 
  58.  */
  59.  
  60. #include "EXTERN.h"
  61. #include "perl.h"
  62.  
  63. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  64. #include <signal.h>
  65. #endif
  66.  
  67. #ifdef BUGGY_MSC
  68.  #pragma function(memcmp)
  69. #endif /* BUGGY_MSC */
  70.  
  71. static void doencodes();
  72.  
  73. #ifdef BUGGY_MSC
  74.  #pragma intrinsic(memcmp)
  75. #endif /* BUGGY_MSC */
  76.  
  77. I32
  78. do_trans(sv,arg)
  79. SV *sv;
  80. OP *arg;
  81. {
  82.     register short *tbl;
  83.     register char *s;
  84.     register I32 matches = 0;
  85.     register I32 ch;
  86.     register char *send;
  87.     register char *d;
  88.     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  89.  
  90.     tbl = (short*) cPVOP->op_pv;
  91.     s = SvPVn(sv);
  92.     send = s + SvCUR(sv);
  93.     if (!tbl || !s)
  94.     fatal("panic: do_trans");
  95.     DEBUG_t( deb("2.TBL\n"));
  96.     if (!op->op_private) {
  97.     while (s < send) {
  98.         if ((ch = tbl[*s & 0377]) >= 0) {
  99.         matches++;
  100.         *s = ch;
  101.         }
  102.         s++;
  103.     }
  104.     }
  105.     else {
  106.     d = s;
  107.     while (s < send) {
  108.         if ((ch = tbl[*s & 0377]) >= 0) {
  109.         *d = ch;
  110.         if (matches++ && squash) {
  111.             if (d[-1] == *d)
  112.             matches--;
  113.             else
  114.             d++;
  115.         }
  116.         else
  117.             d++;
  118.         }
  119.         else if (ch == -1)        /* -1 is unmapped character */
  120.         *d++ = *s;        /* -2 is delete character */
  121.         s++;
  122.     }
  123.     matches += send - d;    /* account for disappeared chars */
  124.     *d = '\0';
  125.     SvCUR_set(sv, d - SvPV(sv));
  126.     }
  127.     SvSETMAGIC(sv);
  128.     return matches;
  129. }
  130.  
  131. void
  132. do_join(sv,del,mark,sp)
  133. register SV *sv;
  134. SV *del;
  135. register SV **mark;
  136. register SV **sp;
  137. {
  138.     SV **oldmark = mark;
  139.     register I32 items = sp - mark;
  140.     register char *delim = SvPVn(del);
  141.     register STRLEN len;
  142.     I32 delimlen = SvCUR(del);
  143.  
  144.     mark++;
  145.     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  146.     if (SvTYPE(sv) < SVt_PV)
  147.     sv_upgrade(sv, SVt_PV);
  148.     if (SvLEN(sv) < len + items) {    /* current length is way too short */
  149.     while (items-- > 0) {
  150.         if (*mark) {
  151.         if (!SvPOK(*mark)) {
  152.             sv_2pv(*mark);
  153.             if (!SvPOK(*mark))
  154.             *mark = &sv_no;
  155.         }
  156.         len += SvCUR((*mark));
  157.         }
  158.         mark++;
  159.     }
  160.     SvGROW(sv, len + 1);        /* so try to pre-extend */
  161.  
  162.     mark = oldmark;
  163.     items = sp - mark;;
  164.     ++mark;
  165.     }
  166.  
  167.     if (items-- > 0)
  168.     sv_setsv(sv, *mark++);
  169.     else
  170.     sv_setpv(sv,"");
  171.     len = delimlen;
  172.     if (len) {
  173.     for (; items > 0; items--,mark++) {
  174.         sv_catpvn(sv,delim,len);
  175.         sv_catsv(sv,*mark);
  176.     }
  177.     }
  178.     else {
  179.     for (; items > 0; items--,mark++)
  180.         sv_catsv(sv,*mark);
  181.     }
  182.     SvSETMAGIC(sv);
  183. }
  184.  
  185. void
  186. do_sprintf(sv,len,sarg)
  187. register SV *sv;
  188. register I32 len;
  189. register SV **sarg;
  190. {
  191.     register char *s;
  192.     register char *t;
  193.     register char *f;
  194.     bool dolong;
  195. #ifdef QUAD
  196.     bool doquad;
  197. #endif /* QUAD */
  198.     char ch;
  199.     register char *send;
  200.     register SV *arg;
  201.     char *xs;
  202.     I32 xlen;
  203.     I32 pre;
  204.     I32 post;
  205.     double value;
  206.  
  207.     sv_setpv(sv,"");
  208.     len--;            /* don't count pattern string */
  209.     t = s = SvPVn(*sarg);
  210.     send = s + SvCUR(*sarg);
  211.     sarg++;
  212.     for ( ; ; len--) {
  213.  
  214.     /*SUPPRESS 560*/
  215.     if (len <= 0 || !(arg = *sarg++))
  216.         arg = &sv_no;
  217.  
  218.     /*SUPPRESS 530*/
  219.     for ( ; t < send && *t != '%'; t++) ;
  220.     if (t >= send)
  221.         break;        /* end of run_format string, ignore extra args */
  222.     f = t;
  223.     *buf = '\0';
  224.     xs = buf;
  225. #ifdef QUAD
  226.     doquad =
  227. #endif /* QUAD */
  228.     dolong = FALSE;
  229.     pre = post = 0;
  230.     for (t++; t < send; t++) {
  231.         switch (*t) {
  232.         default:
  233.         ch = *(++t);
  234.         *t = '\0';
  235.         (void)sprintf(xs,f);
  236.         len++, sarg--;
  237.         xlen = strlen(xs);
  238.         break;
  239.         case '0': case '1': case '2': case '3': case '4':
  240.         case '5': case '6': case '7': case '8': case '9': 
  241.         case '.': case '#': case '-': case '+': case ' ':
  242.         continue;
  243.         case 'lXXX':
  244. #ifdef QUAD
  245.         if (dolong) {
  246.             dolong = FALSE;
  247.             doquad = TRUE;
  248.         } else
  249. #endif
  250.         dolong = TRUE;
  251.         continue;
  252.         case 'c':
  253.         ch = *(++t);
  254.         *t = '\0';
  255.         xlen = SvIVn(arg);
  256.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  257.             *xs = xlen;
  258.             xs[1] = '\0';
  259.             xlen = 1;
  260.         }
  261.         else {
  262.             (void)sprintf(xs,f,xlen);
  263.             xlen = strlen(xs);
  264.         }
  265.         break;
  266.         case 'D':
  267.         dolong = TRUE;
  268.         /* FALL THROUGH */
  269.         case 'd':
  270.         ch = *(++t);
  271.         *t = '\0';
  272. #ifdef QUAD
  273.         if (doquad)
  274.             (void)sprintf(buf,s,(quad)SvNVn(arg));
  275.         else
  276. #endif
  277.         if (dolong)
  278.             (void)sprintf(xs,f,(long)SvNVn(arg));
  279.         else
  280.             (void)sprintf(xs,f,SvIVn(arg));
  281.         xlen = strlen(xs);
  282.         break;
  283.         case 'X': case 'O':
  284.         dolong = TRUE;
  285.         /* FALL THROUGH */
  286.         case 'x': case 'o': case 'u':
  287.         ch = *(++t);
  288.         *t = '\0';
  289.         value = SvNVn(arg);
  290. #ifdef QUAD
  291.         if (doquad)
  292.             (void)sprintf(buf,s,(unsigned quad)value);
  293.         else
  294. #endif
  295.         if (dolong)
  296.             (void)sprintf(xs,f,U_L(value));
  297.         else
  298.             (void)sprintf(xs,f,U_I(value));
  299.         xlen = strlen(xs);
  300.         break;
  301.         case 'E': case 'e': case 'f': case 'G': case 'g':
  302.         ch = *(++t);
  303.         *t = '\0';
  304.         (void)sprintf(xs,f,SvNVn(arg));
  305.         xlen = strlen(xs);
  306.         break;
  307.         case 's':
  308.         ch = *(++t);
  309.         *t = '\0';
  310.         xs = SvPVn(arg);
  311.         if (SvPOK(arg))
  312.             xlen = SvCUR(arg);
  313.         else
  314.             xlen = strlen(xs);
  315.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  316.             break;        /* so handle simple cases */
  317.         }
  318.         else if (f[1] == '-') {
  319.             char *mp = index(f, '.');
  320.             I32 min = atoi(f+2);
  321.  
  322.             if (mp) {
  323.             I32 max = atoi(mp+1);
  324.  
  325.             if (xlen > max)
  326.                 xlen = max;
  327.             }
  328.             if (xlen < min)
  329.             post = min - xlen;
  330.             break;
  331.         }
  332.         else if (isDIGIT(f[1])) {
  333.             char *mp = index(f, '.');
  334.             I32 min = atoi(f+1);
  335.  
  336.             if (mp) {
  337.             I32 max = atoi(mp+1);
  338.  
  339.             if (xlen > max)
  340.                 xlen = max;
  341.             }
  342.             if (xlen < min)
  343.             pre = min - xlen;
  344.             break;
  345.         }
  346.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  347.         *t = ch;
  348.         (void)sprintf(buf,tokenbuf+64,xs);
  349.         xs = buf;
  350.         xlen = strlen(xs);
  351.         break;
  352.         }
  353.         /* end of switch, copy results */
  354.         *t = ch;
  355.         SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
  356.         sv_catpvn(sv, s, f - s);
  357.         if (pre) {
  358.         repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, pre);
  359.         SvCUR(sv) += pre;
  360.         }
  361.         sv_catpvn(sv, xs, xlen);
  362.         if (post) {
  363.         repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, post);
  364.         SvCUR(sv) += post;
  365.         }
  366.         s = t;
  367.         break;        /* break from for loop */
  368.     }
  369.     }
  370.     sv_catpvn(sv, s, t - s);
  371.     SvSETMAGIC(sv);
  372. }
  373.  
  374. void
  375. do_vecset(sv)
  376. SV *sv;
  377. {
  378.     SV *targ = LvTARG(sv);
  379.     register I32 offset;
  380.     register I32 size;
  381.     register unsigned char *s = (unsigned char*)SvPV(targ);
  382.     register unsigned long lval = U_L(SvNVn(sv));
  383.     I32 mask;
  384.  
  385.     offset = LvTARGOFF(sv);
  386.     size = LvTARGLEN(sv);
  387.     if (size < 8) {
  388.     mask = (1 << size) - 1;
  389.     size = offset & 7;
  390.     lval &= mask;
  391.     offset >>= 3;
  392.     s[offset] &= ~(mask << size);
  393.     s[offset] |= lval << size;
  394.     }
  395.     else {
  396.     if (size == 8)
  397.         s[offset] = lval & 255;
  398.     else if (size == 16) {
  399.         s[offset] = (lval >> 8) & 255;
  400.         s[offset+1] = lval & 255;
  401.     }
  402.     else if (size == 32) {
  403.         s[offset] = (lval >> 24) & 255;
  404.         s[offset+1] = (lval >> 16) & 255;
  405.         s[offset+2] = (lval >> 8) & 255;
  406.         s[offset+3] = lval & 255;
  407.     }
  408.     }
  409. }
  410.  
  411. void
  412. do_chop(astr,sv)
  413. register SV *astr;
  414. register SV *sv;
  415. {
  416.     register char *tmps;
  417.     register I32 i;
  418.     AV *ary;
  419.     HV *hash;
  420.     HE *entry;
  421.  
  422.     if (!sv)
  423.     return;
  424.     if (SvTYPE(sv) == SVt_PVAV) {
  425.     I32 max;
  426.     SV **array = AvARRAY(sv);
  427.     max = AvFILL(sv);
  428.     for (i = 0; i <= max; i++)
  429.         do_chop(astr,array[i]);
  430.     return;
  431.     }
  432.     if (SvTYPE(sv) == SVt_PVHV) {
  433.     hash = (HV*)sv;
  434.     (void)hv_iterinit(hash);
  435.     /*SUPPRESS 560*/
  436.     while (entry = hv_iternext(hash))
  437.         do_chop(astr,hv_iterval(hash,entry));
  438.     return;
  439.     }
  440.     tmps = SvPVn(sv);
  441.     if (tmps && SvCUR(sv)) {
  442.     tmps += SvCUR(sv) - 1;
  443.     sv_setpvn(astr,tmps,1);    /* remember last char */
  444.     *tmps = '\0';                /* wipe it out */
  445.     SvCUR_set(sv, tmps - SvPV(sv));
  446.     SvNOK_off(sv);
  447.     SvSETMAGIC(sv);
  448.     }
  449.     else
  450.     sv_setpvn(astr,"",0);
  451. }
  452.  
  453. void
  454. do_vop(optype,sv,left,right)
  455. I32 optype;
  456. SV *sv;
  457. SV *left;
  458. SV *right;
  459. {
  460. #ifdef LIBERAL
  461.     register long *dl;
  462.     register long *ll;
  463.     register long *rl;
  464. #endif
  465.     register char *dc;
  466.     register char *lc = SvPVn(left);
  467.     register char *rc = SvPVn(right);
  468.     register I32 len;
  469.  
  470.     len = SvCUR(left);
  471.     if (len > SvCUR(right))
  472.     len = SvCUR(right);
  473.     if (SvTYPE(sv) < SVt_PV)
  474.     sv_upgrade(sv, SVt_PV);
  475.     if (SvCUR(sv) > len)
  476.     SvCUR_set(sv, len);
  477.     else if (SvCUR(sv) < len) {
  478.     SvGROW(sv,len);
  479.     (void)memzero(SvPV(sv) + SvCUR(sv), len - SvCUR(sv));
  480.     SvCUR_set(sv, len);
  481.     }
  482.     SvPOK_only(sv);
  483.     dc = SvPV(sv);
  484.     if (!dc) {
  485.     sv_setpvn(sv,"",0);
  486.     dc = SvPV(sv);
  487.     }
  488. #ifdef LIBERAL
  489.     if (len >= sizeof(long)*4 &&
  490.     !((long)dc % sizeof(long)) &&
  491.     !((long)lc % sizeof(long)) &&
  492.     !((long)rc % sizeof(long)))    /* It's almost always aligned... */
  493.     {
  494.     I32 remainder = len % (sizeof(long)*4);
  495.     len /= (sizeof(long)*4);
  496.  
  497.     dl = (long*)dc;
  498.     ll = (long*)lc;
  499.     rl = (long*)rc;
  500.  
  501.     switch (optype) {
  502.     case OP_BIT_AND:
  503.         while (len--) {
  504.         *dl++ = *ll++ & *rl++;
  505.         *dl++ = *ll++ & *rl++;
  506.         *dl++ = *ll++ & *rl++;
  507.         *dl++ = *ll++ & *rl++;
  508.         }
  509.         break;
  510.     case OP_XOR:
  511.         while (len--) {
  512.         *dl++ = *ll++ ^ *rl++;
  513.         *dl++ = *ll++ ^ *rl++;
  514.         *dl++ = *ll++ ^ *rl++;
  515.         *dl++ = *ll++ ^ *rl++;
  516.         }
  517.         break;
  518.     case OP_BIT_OR:
  519.         while (len--) {
  520.         *dl++ = *ll++ | *rl++;
  521.         *dl++ = *ll++ | *rl++;
  522.         *dl++ = *ll++ | *rl++;
  523.         *dl++ = *ll++ | *rl++;
  524.         }
  525.     }
  526.  
  527.     dc = (char*)dl;
  528.     lc = (char*)ll;
  529.     rc = (char*)rl;
  530.  
  531.     len = remainder;
  532.     }
  533. #endif
  534.     switch (optype) {
  535.     case OP_BIT_AND:
  536.     while (len--)
  537.         *dc++ = *lc++ & *rc++;
  538.     break;
  539.     case OP_XOR:
  540.     while (len--)
  541.         *dc++ = *lc++ ^ *rc++;
  542.     goto mop_up;
  543.     case OP_BIT_OR:
  544.     while (len--)
  545.         *dc++ = *lc++ | *rc++;
  546.       mop_up:
  547.     len = SvCUR(sv);
  548.     if (SvCUR(right) > len)
  549.         sv_catpvn(sv,SvPV(right)+len,SvCUR(right) - len);
  550.     else if (SvCUR(left) > len)
  551.         sv_catpvn(sv,SvPV(left)+len,SvCUR(left) - len);
  552.     break;
  553.     }
  554. }
  555.